{3:}{$D+,W+}PROGRAM DVI1ED(DVIINFILE,DVIOUTFILE,OUTPUT);LABEL{4:}
9999,1000;{:4}CONST{5:}MAXFONTS=100;LINELENGTH=79;TERMINALLINE=150;
STACKSIZE=100;NAMESIZE=1000;NAMELENGTH=50;MAXPAGES=256;{:5}TYPE{8:}
ASCIICODE=32..126;{:8}{9:}TEXTFILE=PACKED FILE OF CHAR;{:9}{17:}
SPECIALS=(DOERROR,DONORMAL,DONOP,DOBOP,DOEOP,DOPOST,DOPUSH,DOPOP,DOFONT)
;{:17}{27:}EIGHTBITS=0..255;BYTEFILE=PACKED FILE OF EIGHTBITS;{:27}
VAR{10:}XORD:ARRAY[CHAR]OF ASCIICODE;XCHR:ARRAY[0..255]OF CHAR;{:10}
{15:}DVICOPY:ARRAY[EIGHTBITS]OF EIGHTBITS;{:15}{18:}
DVICODE:ARRAY[EIGHTBITS]OF SPECIALS;{:18}{21:}STACK,MAXSTACK:INTEGER;
{:21}{23:}PREVBOPLOC:INTEGER;{:23}{25:}
FONTUSED:ARRAY[0..MAXFONTS]OF BOOLEAN;{:25}{28:}DVIINFILE:BYTEFILE;
DVIOUTFILE:BYTEFILE;TFMFILE:BYTEFILE;{:28}{30:}INCURLOC:INTEGER;
CURNAME:PACKED ARRAY[1..NAMELENGTH]OF CHAR;{:30}{31:}
B0,B1,B2,B3:EIGHTBITS;{:31}{36:}OUTCURLOC:INTEGER;{:36}{39:}
POSTLOC:INTEGER;FIRSTBACKPOI:INTEGER;STARTLOC:INTEGER;
INPAGECOUNT:INTEGER;PAGENO:ARRAY[1..MAXPAGES]OF INTEGER;
PAGELOC:ARRAY[1..MAXPAGES]OF INTEGER;{:39}{43:}MAG,MAXH,MAXV:INTEGER;
{:43}{48:}PAGEWANTED:ARRAY[1..MAXPAGES]OF BOOLEAN;{:48}{51:}
TOTALPAGES:INTEGER;{:51}{55:}NPOSTLOC:INTEGER;{:55}{57:}
DEFAULTDIREC:PACKED ARRAY[1..9]OF CHAR;{:57}{60:}
INFONTNAME:ARRAY[1..40]OF INTEGER;{:60}{62:}F,I,K,M,N,P,Q:INTEGER;{:62}
PROCEDURE INITIALIZE;VAR I,J:INTEGER;
BEGIN WRITELN('This is DVI1ED, Version 1.0');{11:}
FOR I:=0 TO 31 DO XCHR[I]:='?';XCHR[32]:=' ';XCHR[33]:='!';
XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';XCHR[38]:='&';
XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';XCHR[43]:='+';
XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';XCHR[48]:='0';
XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';XCHR[53]:='5';
XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';XCHR[58]:=':';
XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';XCHR[63]:='?';
XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';XCHR[68]:='D';
XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';XCHR[73]:='I';
XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';XCHR[78]:='N';
XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';XCHR[83]:='S';
XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';XCHR[88]:='X';
XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';XCHR[93]:=']';
XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';XCHR[98]:='b';
XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';XCHR[102]:='f';
XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';XCHR[106]:='j';
XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';XCHR[110]:='n';
XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';XCHR[114]:='r';
XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';XCHR[118]:='v';
XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';XCHR[122]:='z';
XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';XCHR[126]:='~';
FOR I:=127 TO 255 DO XCHR[I]:='?';{:11}{12:}
FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;
FOR I:=32 TO 126 DO XORD[XCHR[I]]:=I;{:12}{16:}
FOR I:=0 TO 255 DO DVICOPY[I]:=0;FOR I:=0 TO 127 DO DVICOPY[I]:=0;
DVICOPY[128]:=0;DVICOPY[129]:=40;DVICOPY[130]:=0;DVICOPY[131]:=0;
DVICOPY[132]:=0;DVICOPY[133]:=0;DVICOPY[134]:=8;DVICOPY[135]:=8;
DVICOPY[136]:=1;DVICOPY[137]:=4;DVICOPY[138]:=4;DVICOPY[139]:=3;
DVICOPY[140]:=2;DVICOPY[141]:=0;DVICOPY[142]:=4;DVICOPY[143]:=3;
DVICOPY[144]:=2;DVICOPY[145]:=0;DVICOPY[146]:=4;DVICOPY[147]:=3;
DVICOPY[148]:=2;DVICOPY[149]:=0;DVICOPY[150]:=4;DVICOPY[151]:=3;
DVICOPY[152]:=2;DVICOPY[153]:=0;FOR I:=154 TO 217 DO DVICOPY[I]:=0;{:16}
{19:}FOR I:=0 TO 255 DO DVICODE[I]:=DOERROR;
FOR I:=0 TO 127 DO DVICODE[I]:=DONORMAL;DVICODE[128]:=DONOP;
DVICODE[129]:=DOBOP;DVICODE[130]:=DOEOP;DVICODE[131]:=DOPOST;
DVICODE[132]:=DOPUSH;DVICODE[133]:=DOPOP;DVICODE[134]:=DONORMAL;
DVICODE[135]:=DONORMAL;DVICODE[136]:=DONORMAL;DVICODE[137]:=DOERROR;
DVICODE[138]:=DONORMAL;DVICODE[139]:=DONORMAL;DVICODE[140]:=DONORMAL;
DVICODE[141]:=DONORMAL;DVICODE[142]:=DONORMAL;DVICODE[143]:=DONORMAL;
DVICODE[144]:=DONORMAL;DVICODE[145]:=DONORMAL;DVICODE[146]:=DONORMAL;
DVICODE[147]:=DONORMAL;DVICODE[148]:=DONORMAL;DVICODE[149]:=DONORMAL;
DVICODE[150]:=DONORMAL;DVICODE[151]:=DONORMAL;DVICODE[152]:=DONORMAL;
DVICODE[153]:=DONORMAL;FOR I:=154 TO 217 DO DVICODE[I]:=DOFONT;{:19}
{22:}MAXSTACK:=0;{:22}{24:}PREVBOPLOC:=-1;{:24}{26:}
FOR I:=0 TO MAXFONTS DO FONTUSED[I]:=FALSE;{:26}{41:}INPAGECOUNT:=0;
{:41}{49:}FOR I:=1 TO MAXPAGES DO PAGEWANTED[I]:=FALSE;{:49}{52:}
TOTALPAGES:=0;{:52}{58:}DEFAULTDIREC:='ALFfonts:';{:58}END;{:3}{7:}
PROCEDURE JUMPOUT;BEGIN GOTO 9999;END;{:7}{29:}PROCEDURE OPENINDVIFIL;
BEGIN RESET(DVIINFILE,'','/B:8');INCURLOC:=0;END;PROCEDURE OPENTFMFILE;
BEGIN RESET(TFMFILE,CURNAME,'/B:8/O/N:9');END;{:29}{32:}
PROCEDURE READTFMWORD;BEGIN READ(TFMFILE,B0);READ(TFMFILE,B1);
READ(TFMFILE,B2);READ(TFMFILE,B3);END;{:32}{33:}
FUNCTION GETBYTE:INTEGER;VAR B:EIGHTBITS;
BEGIN IF EOF(DVIINFILE)THEN GETBYTE:=0 ELSE BEGIN READ(DVIINFILE,B);
INCURLOC:=INCURLOC+1;GETBYTE:=B;END;END;FUNCTION SIGNEDBYTE:INTEGER;
VAR B:EIGHTBITS;BEGIN READ(DVIINFILE,B);INCURLOC:=INCURLOC+1;
IF B<128 THEN SIGNEDBYTE:=B ELSE SIGNEDBYTE:=B-256;END;
FUNCTION GETTWOBYTES:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(DVIINFILE,A);
READ(DVIINFILE,B);INCURLOC:=INCURLOC+2;GETTWOBYTES:=A*256+B;END;
FUNCTION SIGNEDPAIR:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(DVIINFILE,A);
READ(DVIINFILE,B);INCURLOC:=INCURLOC+2;
IF A<128 THEN SIGNEDPAIR:=A*256+B ELSE SIGNEDPAIR:=(A-256)*256+B;END;
FUNCTION GETTHREEBYTE:INTEGER;VAR A,B,C:EIGHTBITS;
BEGIN READ(DVIINFILE,A);READ(DVIINFILE,B);READ(DVIINFILE,C);
INCURLOC:=INCURLOC+3;GETTHREEBYTE:=(A*256+B)*256+C;END;
FUNCTION SIGNEDTRIO:INTEGER;VAR A,B,C:EIGHTBITS;BEGIN READ(DVIINFILE,A);
READ(DVIINFILE,B);READ(DVIINFILE,C);INCURLOC:=INCURLOC+3;
IF A<128 THEN SIGNEDTRIO:=(A*256+B)*256+C ELSE SIGNEDTRIO:=((A-256)*256+
B)*256+C;END;FUNCTION SIGNEDQUAD:INTEGER;VAR A,B,C,D:EIGHTBITS;
BEGIN READ(DVIINFILE,A);READ(DVIINFILE,B);READ(DVIINFILE,C);
READ(DVIINFILE,D);INCURLOC:=INCURLOC+4;
IF A<128 THEN SIGNEDQUAD:=((A*256+B)*256+C)*256+D ELSE SIGNEDQUAD:=(((A
-256)*256+B)*256+C)*256+D;END;{:33}{34:}FUNCTION DVILENGTH:INTEGER;
BEGIN SETPOS(DVIINFILE,-1);DVILENGTH:=CURPOS(DVIINFILE);END;
PROCEDURE MOVETOBYTE(N:INTEGER);BEGIN SETPOS(DVIINFILE,N);INCURLOC:=N;
END;{:34}{35:}PROCEDURE OPENOUTDVIFI;
BEGIN REWRITE(DVIOUTFILE,'','/B:8');OUTCURLOC:=0;END;{:35}{37:}
PROCEDURE PUTBYTE(X:INTEGER);BEGIN IF X>0 THEN BEGIN X:=X+1073741824;
X:=X+1073741824;END;WRITE(DVIOUTFILE,X MOD 256);OUTCURLOC:=OUTCURLOC+1;
END;PROCEDURE PUTTWOBYTES(X:INTEGER);
BEGIN IF X>0 THEN BEGIN X:=X+1073741824;X:=X+1073741824;END;
X:=X MOD 65536;WRITE(DVIOUTFILE,X DIV 256);WRITE(DVIOUTFILE,X MOD 256);
OUTCURLOC:=OUTCURLOC+2;END;PROCEDURE PUTTHREEBYTE(X:INTEGER);
BEGIN IF X>0 THEN BEGIN X:=X+1073741824;X:=X+1073741824;END;
X:=X MOD 16777216;WRITE(DVIOUTFILE,X DIV 65536);X:=X MOD 65536;
WRITE(DVIOUTFILE,X DIV 256);WRITE(DVIOUTFILE,X MOD 256);
OUTCURLOC:=OUTCURLOC+3;END;PROCEDURE PUTQUAD(X:INTEGER);
BEGIN IF X>=0 THEN WRITE(DVIOUTFILE,X DIV 16777216)ELSE BEGIN X:=X
+1073741824;X:=X+1073741824;WRITE(DVIOUTFILE,(X DIV 16777216)+128);END;
X:=X MOD 16777216;WRITE(DVIOUTFILE,X DIV 65536);X:=X MOD 65536;
WRITE(DVIOUTFILE,X DIV 256);WRITE(DVIOUTFILE,X MOD 256);
OUTCURLOC:=OUTCURLOC+4;END;{:37}{42:}PROCEDURE READPOSTAMBL;
VAR K:INTEGER;I,P,Q,M:INTEGER;
BEGIN WRITELN('Postamble starts at byte ',POSTLOC:1,'.');
IF SIGNEDQUAD<>1 THEN WRITELN('numerator not 1!');
IF SIGNEDQUAD<>1 THEN WRITELN('denominator not 1!');MAG:=SIGNEDQUAD;
WRITELN('Magnification is ',MAG:1);MAXV:=SIGNEDQUAD;MAXH:=SIGNEDQUAD;
WRITELN('maxv=',MAXV:1,', maxh=',MAXH:1);{45:}K:=SIGNEDQUAD;
WHILE K<>-1 DO BEGIN K:=SIGNEDQUAD;K:=SIGNEDQUAD;K:=GETBYTE;
FOR I:=1 TO K DO P:=GETBYTE;K:=SIGNEDQUAD END;{:45};{44:}Q:=SIGNEDQUAD;
IF Q<>POSTLOC THEN WRITELN('bad postamble pointer in byte ',INCURLOC-4:1
,'!');M:=GETBYTE;
IF M<>1 THEN WRITELN('identification in byte ',INCURLOC-1:1,
' should be ',1:1,'!');K:=INCURLOC;M:=223;
WHILE(M=223)AND NOT EOF(DVIINFILE)DO M:=GETBYTE;
IF NOT EOF(DVIINFILE)THEN BEGIN WRITE(' ','Bad DVI file: ',
'signature in byte ',INCURLOC-1:1,' should be 223','!');JUMPOUT;
END ELSE IF INCURLOC<K+4 THEN WRITELN(
'not enough signature bytes at end of file (',INCURLOC-K:1,')');{:44};
END;{:42}{46:}PROCEDURE DIALOG;VAR I,P,START,NUM:INTEGER;
MORE,OK:BOOLEAN;CH:CHAR;BEGIN WRITE(TTYOUTPUT,'DVI page numbers: ');
FOR P:=INPAGECOUNT DOWNTO 1 DO BEGIN WRITE(TTYOUTPUT,PAGENO[P]:1,' ');
IF P MOD 30=0 THEN WRITELN(TTYOUTPUT);END;WRITELN(TTYOUTPUT);
P:=INPAGECOUNT;REPEAT{47:}REPEAT OK:=TRUE;
WRITE(TTYOUTPUT,'Want more? (n,y,r) ');REPEAT READ(TTY,CH)UNTIL CH>' ';
IF(CH='n')OR(CH='N')THEN MORE:=FALSE ELSE IF(CH='y')OR(CH='Y')THEN MORE
:=TRUE ELSE IF(CH='r')OR(CH='R')THEN BEGIN MORE:=TRUE;P:=INPAGECOUNT;
END ELSE BEGIN OK:=FALSE;
WRITE(TTYOUTPUT,'"',CH,'" invalid, try again.');END;UNTIL OK;
IF MORE THEN BEGIN WRITE(TTYOUTPUT,'Starting page? ');READ(TTY,START);
END;{:47};IF MORE THEN BEGIN WHILE(P>0)AND(PAGENO[P]<>START)DO P:=P-1;
IF P<1 THEN WRITELN(TTYOUTPUT,'Page ',START:1,
' not found.  Type "r" to restart.')ELSE BEGIN WRITE(TTYOUTPUT,
'Number of pages? ');READ(TTY,NUM);
IF P>=NUM THEN FOR I:=P DOWNTO P-NUM+1 DO BEGIN PAGEWANTED[I]:=TRUE;
WRITE(TTYOUTPUT,' [',PAGENO[I]:1,']');
END ELSE WRITE(TTYOUTPUT,'Not enough pages, only ',I:1,' pages left.');
P:=P-NUM;WRITELN(TTYOUTPUT);END;END;UNTIL NOT MORE OR(I<1);
WRITELN(TTYOUTPUT);WRITELN(TTYOUTPUT);END;{:46}{50:}PROCEDURE COPYPAGE;
VAR BOPLOC:INTEGER;I,T:INTEGER;DVICMD:INTEGER;INCMDLOC:INTEGER;
DVIBYTE:INTEGER;BEGIN INCMDLOC:=INCURLOC;
REPEAT DVICMD:=GETBYTE UNTIL DVICMD<>128;
IF DVICMD=131 THEN GOTO 1000 ELSE IF DVICMD<>129 THEN BEGIN WRITE(' ',
'BOP expected at ',OUTCURLOC-1:1,', found ',DVICMD:1,' instead.');
JUMPOUT;END;TOTALPAGES:=TOTALPAGES+1;REPEAT{20:}
CASE DVICODE[DVICMD]OF DOERROR:BEGIN WRITE(' ','Bad DVI file: ',DVICMD:1
,' at location ',INCMDLOC:1,'!');JUMPOUT;END;
DONORMAL:BEGIN PUTBYTE(DVICMD);
FOR I:=1 TO DVICOPY[DVICMD]DO BEGIN DVIBYTE:=GETBYTE;PUTBYTE(DVIBYTE);
END;END;DONOP:;DOBOP:BEGIN BOPLOC:=OUTCURLOC;PUTBYTE(DVICMD);
T:=SIGNEDQUAD;PUTQUAD(T+1);
FOR I:=5 TO DVICOPY[DVICMD]DO BEGIN DVIBYTE:=GETBYTE;PUTBYTE(DVIBYTE);
END;I:=SIGNEDQUAD;PUTQUAD(PREVBOPLOC);PREVBOPLOC:=BOPLOC;END;
DOEOP:PUTBYTE(DVICMD);
DOPOST:BEGIN WRITE(' ','Found postamble when reading pages.');JUMPOUT;
END;DOPUSH:BEGIN PUTBYTE(DVICMD);STACK:=STACK+1;
IF STACK>MAXSTACK THEN MAXSTACK:=STACK;END;DOPOP:BEGIN PUTBYTE(DVICMD);
STACK:=STACK-1;IF STACK<0 THEN BEGIN WRITE(' ','Bad DVI file: ',
'stack underflow at location ',INCMDLOC:1,'!');JUMPOUT;END;END;
DOFONT:BEGIN PUTBYTE(DVICMD);FONTUSED[DVICMD-154]:=TRUE;
FOR I:=1 TO DVICOPY[DVICMD]DO BEGIN DVIBYTE:=GETBYTE;PUTBYTE(DVIBYTE);
END;END;END;{:20};INCMDLOC:=INCURLOC;DVICMD:=GETBYTE UNTIL DVICMD=130;
PUTBYTE(130);END;{:50}{61:}BEGIN INITIALIZE;OPENINDVIFIL;OPENOUTDVIFI;
{38:}N:=DVILENGTH;
IF N<53 THEN BEGIN WRITE(' ','Bad DVI file: ','only ',N:1,' bytes long',
'!');JUMPOUT;END;M:=N-4;
REPEAT IF M=0 THEN BEGIN WRITE(' ','Bad DVI file: ','all 223s','!');
JUMPOUT;END;MOVETOBYTE(M);K:=GETBYTE;M:=M-1;UNTIL K<>223;
IF K<>1 THEN BEGIN WRITE(' ','Bad DVI file: ','ID byte is ',K:1,'!');
JUMPOUT;END;MOVETOBYTE(M-3);Q:=SIGNEDQUAD;
IF(Q<0)OR(Q>M-33)THEN BEGIN WRITE(' ','Bad DVI file: ','post pointer ',Q
:1,' at byte ',M-3:1,'!');JUMPOUT;END;MOVETOBYTE(Q);K:=GETBYTE;
IF K<>131 THEN BEGIN WRITE(' ','Bad DVI file: ','byte ',Q:1,
' is not post','!');JUMPOUT;END;POSTLOC:=Q;FIRSTBACKPOI:=SIGNEDQUAD{:38}
;{40:}Q:=POSTLOC;P:=FIRSTBACKPOI;STARTLOC:=-1;
BEGIN REPEAT IF P>Q-46 THEN BEGIN WRITE(' ','Bad DVI file: ',
'page link ',P:1,' after byte ',Q:1,'!');JUMPOUT;END;Q:=P;MOVETOBYTE(Q);
K:=GETBYTE;
IF K=129 THEN INPAGECOUNT:=INPAGECOUNT+1 ELSE BEGIN WRITE(' ',
'Bad DVI file: ','byte ',Q:1,' is not bop','!');JUMPOUT;END;
PAGELOC[INPAGECOUNT]:=Q;PAGENO[INPAGECOUNT]:=SIGNEDQUAD+1;
MOVETOBYTE(Q+41);P:=SIGNEDQUAD;UNTIL P<0;END;{:40};DIALOG;{53:}
WRITELN('Sending pages to output.');
FOR K:=INPAGECOUNT DOWNTO 1 DO IF PAGEWANTED[K]THEN BEGIN MOVETOBYTE(
PAGELOC[K]);WRITE(' [',PAGENO[K]:1,']');COPYPAGE;END;{:53};1000:{54:}
MOVETOBYTE(POSTLOC);P:=GETBYTE;
IF P<>131 THEN BEGIN WRITE(' ','Bad DVI file: ',
'expected postamble, found ',P:1,'!');JUMPOUT;END;NPOSTLOC:=OUTCURLOC;
PUTBYTE(131);P:=SIGNEDQUAD;PUTQUAD(PREVBOPLOC);K:=SIGNEDQUAD;PUTQUAD(K);
K:=SIGNEDQUAD;PUTQUAD(K);MAG:=SIGNEDQUAD;PUTQUAD(MAG);MAXV:=SIGNEDQUAD;
PUTQUAD(MAXV);MAXH:=SIGNEDQUAD;PUTQUAD(MAXH);{56:}F:=SIGNEDQUAD;
WHILE F<>-1 DO BEGIN WRITELN(' ');WRITE('Font ',F:1);
IF NOT FONTUSED[F]THEN WRITE(' not used');IF FONTUSED[F]THEN PUTQUAD(F);
K:=SIGNEDQUAD;IF FONTUSED[F]THEN PUTQUAD(K);K:=SIGNEDQUAD;
IF FONTUSED[F]THEN PUTQUAD(K);{59:}N:=GETBYTE;P:=1;WRITE(' ');
FOR I:=1 TO N DO BEGIN INFONTNAME[I]:=GETBYTE;
WRITE(XCHR[INFONTNAME[I]]);
IF(INFONTNAME[I]=ORD('>'))OR(INFONTNAME[I]=ORD(':'))THEN P:=I+1;END;
IF FONTUSED[F]THEN BEGIN PUTBYTE(9+N-P+1);
FOR I:=1 TO 9 DO PUTBYTE(ORD(DEFAULTDIREC[I]));
FOR I:=P TO N DO PUTBYTE(INFONTNAME[I]);END;{:59};
IF K<>1000 THEN WRITE(' at ',K:1);F:=SIGNEDQUAD;END;PUTQUAD(-1);{:56};
PUTQUAD(NPOSTLOC);PUTBYTE(1);PUTBYTE(223);PUTBYTE(223);PUTBYTE(223);
PUTBYTE(223);FOR K:=(OUTCURLOC MOD 4)TO 3 DO PUTBYTE(223);{:54};
9999:END.{:61}